Initial Set Up Steps

library(shinydashboard)
library(tidyverse)
library(leaflet)
library(shiny)
library(Rcpp)
library(sf)
library(tmaptools)
library(htmlwidgets)
library(googlesheets4)
library(RColorBrewer)
library(lubridate)
library(purrr)
library(shinythemes)

library(censusapi)
library(rgeos)
library(tidycensus)
library(tigris)
library(usmap)

library(colorspace)
library(ggplot2)
library(reshape2)
library(formattable)
library(plotly)
library(lubridate)

Sys.setenv(CENSUS_KEY="c8aa67e4086b4b5ce3a8717f59faa9a28f611dab")
github_directory <- "https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/"
github_rds <- "https://github.com/stanfordfuturebay/stanfordfuturebay.github.io/blob/master/data/"

options(
  tigris_class = "sf",
  tigris_use_cache = TRUE
)

mapbox_sat <- "https://api.mapbox.com/styles/v1/samanyl/ck9hpl0sm0fuq1ip8yfb2yrn8/tiles/256/{z}/{x}/{y}@2x?access_token=pk.eyJ1Ijoic2FtYW55bCIsImEiOiJjazlocGNvYWgxMHhxM2Rud2pxdzVnMnp2In0.D_j3K9tXiEddHH-8UUkeZQ"
mapbox_satAtt <- "© <a href='https://www.mapbox.com/map-feedback/'>Mapbox</a> Satellite Map"

bay_county_names <-
  c(
    "Alameda",
    "Contra Costa",
    "Marin",
    "Napa",
    "San Francisco",
    "San Mateo",
    "Santa Clara",
    "Solano",
    "Sonoma"
  )

bay_counties <- readRDS(gzcon(url(paste0(github_rds,"bay_counties.rds?raw=true"))))

setwd("C:/Users/liusa/github/covid19/snap project/sam")


# bay_counties <-
#   counties("CA", cb = F, progress_bar=F) %>%
#   filter(NAME %in% bay_county_names)
#
# zctas <-
#   zctas(cb=F)
#
# bay_zctas <-
#   zctas %>%
#   dplyr::select(ZCTA5CE10) %>%
#   st_join(bay_counties %>% dplyr::select(geometry),left=F)
#
# saveRDS(bay_zctas, file = "bay_zctas.rds")

gs4_deauth()

retailers <- read_sheet("1tvMBCWNeh7kyyKklntmWfV1zNJx8bN-KxHIYmaULZxg")

retailers$long <- as.numeric(retailers$long)
retailers$lat <- as.numeric(retailers$lat)

snap <- retailers %>% filter(type == "SNAP_accepting_retailer")
wic <- retailers %>% filter(type == "WIC_only_store")
snap_wic <- retailers %>% filter(type == "WIC_SNAP_retailer")
snap_restaurant <- retailers %>% filter(type=="SNAP_restaurant")
snap_farmers <- retailers %>% filter(type=="SNAP_farmers_market")

snap_curbside <- snap %>% filter(!is.na(curbside_pickup))
wic_curbside <- wic %>% filter(!is.na(curbside_pickup))
snapwic_curbside <- snap_wic %>% filter(!is.na(curbside_pickup))
snaprest_curbside <- snap_restaurant %>% filter(!is.na(curbside_pickup))
snapfarm_curbside <- snap_farmers %>% filter(!is.na(curbside_pickup))

snap_delivery <- snap %>% filter(!is.na(delivery))
wic_delivery <- wic %>% filter(!is.na(delivery))
snapwic_delivery <- snap_wic %>% filter(!is.na(delivery))
snaprest_delivery <- snap_restaurant %>% filter(!is.na(delivery))
snapfarm_delivery <- snap_farmers %>% filter(!is.na(delivery))

snap_senior <- snap %>% filter(!is.na(senior_hours))
wic_senior <- wic %>% filter(!is.na(senior_hours))
snapwic_senior <- snap_wic %>% filter(!is.na(senior_hours))
snaprest_senior <- snap_restaurant %>% filter(!is.na(senior_hours))
snapfarm_senior <- snap_farmers %>% filter(!is.na(senior_hours))

snapIcon <- makeIcon(
  iconUrl = "baymap/bag.png",
  iconWidth=25,iconHeight=25)

wicIcon <- makeIcon(
  iconUrl = "baymap/love.png",
  iconWidth=30,iconHeight=30)

snapwicIcon <- makeIcon(
  iconUrl = "baymap/snapwic.png",
  iconWidth=30,iconHeight=30)

snaprestIcon <- makeIcon(
  iconUrl = "baymap/cutlery.png",
  iconWidth=25,iconHeight=25)

snapfarmIcon <- makeIcon(
  iconUrl = "baymap/chicken.png",
  iconWidth=25,iconHeight=25)

homeIcon <- makeIcon(
  iconUrl = "baymap/internet.png",
  iconWidth=25,iconHeight=25)

html_legend <- "<img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/bag.png' height='30' width='30'> SNAP Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/love.png' height='30' width='30'> WIC Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/snapwic.png' height='30' width='30'> SNAP and WIC Accepting Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/money.png' height='30' width='30'> Cash EBT Withdrawal Locations<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/cutlery.png' height='30' width='30'> SNAP Accepting Restaurants<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/chicken.png' height='30' width='30'> SNAP Accepting Farmers Markets"

cluster <-
  markerClusterOptions(
    showCoverageOnHover=F,
    spiderfyOnMaxZoom=F,
    disableClusteringAtZoom=14
    )

# time format --> format(dataset$____, %I:%M%p)

pop <- function(dataset){
  result <-
    paste0(
      ifelse(
        is.na(dataset$web_link),
        paste0("<strong>",dataset$site_name,"</strong><br>"),
        paste0("<a href='",dataset$web_link,"' target='_blank'><strong>",dataset$site_name,"</strong></a><br>")
      ),
      dataset$address, "<br>",
      dataset$city,", ",
      dataset$state," ",
      dataset$zip,
      "<br><br><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/pin.png' height='12' width='12'>
      <a href='https://www.google.com/maps/dir/?api=1&destination=",
      dataset$lat,",",
      dataset$long,"' target='_blank'>Directions To Here</a>",
      '<br><br><strong>Hours of Operation: </strong><br>',
      dataset$days_hours_line1,
      ifelse(
        is.na(dataset$days_hours_line2),
        "",
        paste0("<br>",dataset$days_hours_line2)
      ),
      ifelse(
        is.na(dataset$days_hours_line3),
        "",
        paste0("<br>",dataset$days_hours_line3)
      ),
      ifelse(
        is.na(dataset$days_hours_line4),
        "",
        paste0("<br>",dataset$days_hours_line4)
      ),
      "<br><br><strong>Contact Information:</strong><br>",
      ifelse(
        is.na(dataset$web_link),
        "",
        paste0("<a href='",dataset$web_link,"' target='_blank'>Website</a><br>")
      ),
      dataset$phone,"<br>",
      ifelse(
        is.na(dataset$notes),
        "",
        paste0("<br><strong>Notes: </strong>",dataset$notes,"<br>")
      ),
      ifelse(
        is.na(dataset$senior_hours),
        "",
        paste0(
          '<br><strong style="color:red">** SPECIAL SENIOR HOURS ** </strong><br>',
          dataset$senior_hours)
      )
    )
  return(result)
}

bay_zctas <- readRDS("P:/Stanford/Classes/CEE218Z - Shaping the Future of the Bay/bay_zctas.rds")

wd <- "P:/Shared/SFBI/Restricted Data Library/Safegraph/covid19analysis/transactions-facteus/"

combining <- function(pattern) {
  files <- list.files(pattern = pattern)
  return(do.call(rbind, lapply(files,readRDS)))
}

spending_total <- readRDS(paste0(wd,"cut-1-daily-spend-by-zip/2020-04-22/cut-1-daily-spend-by-zip-20170101-20200417-bay.rds"))

setwd(paste0(wd,"cut-2-daily-spend-by-zip-by-mcc/2020-04-22"))
spending_MCC <-
  combining("cut-2-daily-spend-by-zip-by-mcc-20170101-20200417-[0-1][0-9]-bay.rds")

setwd(paste0(wd,"cut-3-daily-spend-by-brand/2020-04-22"))
spending_brand <- combining("daily-spend-by-brand-20170101-20200417-[0-1][0-9]-bay.rds")

walmart_instore <- readRDS(paste0(wd,"cut-4-daily-spend-at-walmart/2020-04-22/daily-spend-by-zip-walmart-instore-20170101-20200417-bay.rds"))

walmart_online <- readRDS(paste0(wd,"cut-4-daily-spend-at-walmart/2020-04-22/daily-spend-by-zip-walmart-online-20170101-20200417-bay.rds"))

gcf <- read.csv("P:/Shared/SFBI/Restricted Data Library/CalFresh/last_365_by_zip.csv")

setwd("C:/Users/liusa/github/covid19/snap project/sam")

Leaflet Snap Circle Icons

cols <- brewer.pal(5, name='Set1')
retail.col <- colorFactor(cols, domain = c("SNAP_accepting_retailer","WIC_only_store","WIC_SNAP_retailer","SNAP_restaurant",
                                           "SNAP_farmers_market"))

mpc <- leaflet() %>%
    addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
    addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
    addCircleMarkers(
      lng = retailers$long,
      lat = retailers$lat,
      color = retail.col(retailers$type),
      radius = 5,
      popup = pop(retailers)
      ) %>%
    addLegend(
      position = 'bottomleft',
      values = subset(retailers$type,!is.na(retailers$type)),
      na.label = "",
      pal = retail.col,
      title='Stores'
      ) %>%
    addLayersControl(
      baseGroups = c("Default","Satellite")
      )

mpc

Leaflet Snap with Flat Icons

mpi <- leaflet() %>%
    addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
    # addProviderTiles(providers$CartoDB.Positron, group = "Positron") %>% # add mapbox
    addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
    addMarkers(
      lng = snap$long,
      lat = snap$lat,
      clusterOptions = cluster,
      popup = pop(snap),
      icon = snapIcon,
      group = "SNAP Only Retailers"
      ) %>%
    addMarkers(
      lng = wic$long,
      lat = wic$lat,
      clusterOptions = cluster,
      popup = pop(wic),
      icon = wicIcon,
      group = "WIC Only Retailers"
      ) %>%
    addMarkers(
      lng = snap_wic$long,
      lat = snap_wic$lat,
      clusterOptions = cluster,
      popup = pop(snap_wic),
      icon = snapwicIcon,
      group = "SNAP and WIC Accepting Retailers"
      ) %>%
    addMarkers(
      lng = snap_restaurant$long,
      lat = snap_restaurant$lat,
      clusterOptions = cluster,
      popup = pop(snap_restaurant),
      icon = snaprestIcon,
      group = "SNAP Accepting Restaurants"
      ) %>%
    addMarkers(
      lng = snap_farmers$long,
      lat = snap_farmers$lat,
      clusterOptions = cluster,
      popup = pop(snap_farmers),
      icon = snapfarmIcon,
      group = "SNAP Accepting Farmers Markets"
      ) %>%
    addMarkers(
      lng = snap_curbside$long,
      lat = snap_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snap_curbside),
      icon = snapIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = wic_curbside$long,
      lat = wic_curbside$lat,
      clusterOptions = cluster,
      popup = pop(wic_curbside),
      icon = wicIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snapwic_curbside$long,
      lat = snapwic_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_curbside),
      icon = snapwicIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snaprest_curbside$long,
      lat = snaprest_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_curbside),
      icon = snaprestIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snapfarm_curbside$long,
      lat = snapfarm_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_curbside),
      icon = snapfarmIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snap_delivery$long,
      lat = snap_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snap_delivery),
      icon = snapIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = wic_delivery$long,
      lat = wic_delivery$lat,
      clusterOptions = cluster,
      popup = pop(wic_delivery),
      icon = wicIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snapwic_delivery$long,
      lat = snapwic_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_delivery),
      icon = snapwicIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snaprest_delivery$long,
      lat = snaprest_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_delivery),
      icon = snaprestIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snapfarm_delivery$long,
      lat = snapfarm_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_delivery),
      icon = snapfarmIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snap_senior$long,
      lat = snap_senior$lat,
      clusterOptions = cluster,
      popup = pop(snap_senior),
      icon = snapIcon,
      group = "Offers Senior Hours"
      ) %>%
    addMarkers(
      lng = wic_senior$long,
      lat = wic_senior$lat,
      clusterOptions = cluster,
      popup = pop(wic_senior),
      icon = wicIcon,
      group = "Offers Delivery"
      ) %>%
    addMarkers(
      lng = snapwic_senior$long,
      lat = snapwic_senior$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_senior),
      icon = snapwicIcon,
      group = "Offers Delivery"
      ) %>%
    addMarkers(
      lng = snaprest_senior$long,
      lat = snaprest_senior$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_senior),
      icon = snaprestIcon,
      group = "Offers Delivery"
      ) %>%
    addMarkers(
      lng = snapfarm_senior$long,
      lat = snapfarm_senior$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_senior),
      icon = snapfarmIcon,
      group = "Offers Delivery"
      ) %>%
    addLayersControl(
      baseGroups = c("Default","Satellite"),
      overlayGroups = c("SNAP Only Retailers","WIC Only Retailers","SNAP and WIC Accepting Retailers","Cash EBT Withdrawal Locations",
                        "SNAP Accepting Restaurants","SNAP Accepting Farmers Markets",
                        "Offers Curbside Pick-up", "Offers Delivery","Offers Senior Hours")
      ) %>%
    addControl(
      html=html_legend,
      position="bottomleft") %>%
  hideGroup(c("Offers Curbside Pick-up", "Offers Delivery","Offers Senior Hours"))

mpi

2019 vs 2020 Spending Trends Between January and April

# spending distribution of products (bar charts)
# spending_MCC_sum <-
#   spending_MCC %>%
#   mutate(year=substr(date,1,4)) %>%
#   mutate(month = substr(date,6,7)) %>%
#   group_by(year,month,MCC) %>%
#   summarize(
#     mean=mean(as.numeric(total_spent)),
#     sum=sum(as.numeric(total_spent)),
#     transactions=sum(as.numeric(transaction_counts)),
#     avg_transactions=mean(as.numeric(transaction_counts)))
# 
# spending_MCC_1920 <-
#   spending_MCC_sum %>%
#   filter(year %in% c("2019","2020"), month %in% c("01","02","03","04"), MCC > 0)
# 
# spending_MCC_1920 <-
#   spending_MCC_1920[order(spending_MCC_1920$MCC),]
# 
# spending_MCC_1920 <-
#   spending_MCC_1920[-c(1,2,3,4),]
# 
# saveRDS(spending_MCC_1920,"baymap/spending_MCC_1920.rds")
# 
# mcc_codes <- 
#   read_csv("https://raw.githubusercontent.com/greggles/mcc-codes/master/mcc_codes.csv") %>% 
#   dplyr::select(
#     MCC = mcc,
#     label = edited_description
#   ) %>% 
#   saveRDS("baymap/mcc_codes.rds")

spending_MCC_1920 <- readRDS("baymap/spending_MCC_1920.rds")
mcc_codes <- readRDS("baymap/mcc_codes.rds")

plot_month <- function(m,abbr) {
  spend20 <-
    spending_MCC_1920 %>%
    filter(month==m,year=="2020")

  spend1920 <-
    spending_MCC_1920 %>%
    filter(month==m,year=="2019") %>%
    right_join(spend20,by=c("MCC","month"),suffix=c("_2019","_2020")) %>%
    filter(!is.na(transactions_2019) & !is.na(transactions_2020) & !is.na(year_2019) & !is.na(year_2020)) %>% 
    arrange(transactions_2020) 

  spend1920 <-
    spend1920 %>%
    tail(10) %>% 
    dplyr::select(year_2019,year_2020,transactions_2019,transactions_2020,MCC)
  
  spend1920 <- spend1920[c("MCC", "year_2019", "year_2020", "transactions_2019", "transactions_2020")]

  spend20 <-
    spend1920 %>% 
    dplyr::select(year_2020,transactions_2020,MCC) %>% 
    dplyr::rename("year" = "year_2020","transactions"="transactions_2020")

  spend19 <-
    spend1920 %>% 
    dplyr::select(year_2019,transactions_2019,MCC) %>% 
    dplyr::rename("year" = "year_2019","transactions"="transactions_2019")

  spend1920_plt <-
    spend19 %>%
    full_join(spend20) %>% 
    left_join(mcc_codes,by=("MCC")) %>% 
    ungroup()
  
  plt <- 
    (ggplot(spend1920_plt,aes(x=MCC,y=transactions,fill=year,group=year,text=paste0(label,": ",transactions))) +
    scale_fill_brewer(palette="Paired") +
    geom_bar(stat="identity",position=position_dodge()) +
    labs(title=abbr,y= "MCC", x = "Total Transactions", color="Legend") +
    coord_flip() +
    theme_minimal() +
    theme(legend.position = "top")) %>% 
    ggplotly(tooltip="text") %>%
    config(displayModeBar = F)

  spend1920_tbl <-
    spend1920 %>%
    left_join(mcc_codes,by=("MCC")) %>% 
    dplyr::select(MCC, label, transactions_2019,transactions_2020) %>%
    dplyr::rename("2019" = "transactions_2019","2020"="transactions_2020","Description"="label") %>% 
    formattable(align = c("c","l","c","c"))

  values <- list("plt" = plt,"tbl" = spend1920_tbl)

  return(values)
}

jan <- plot_month("01","Jan")
jan$plt

jan$tbl

MCC	Description	2019	2020
5542	Automated Fuel Dispensers	44456	43278
4829	Money Orders – Wire Transfer	13581	43782
5499	Misc. Food Stores – Convenience Stores and Specialty Markets	40627	49610
6011	Financial Institutions – Manual Cash Disbursements	45488	66778
4121	Taxicabs and Limousines	81206	74901
5812	Eating places and Restaurants	139639	150149
5999	Miscellaneous and Specialty Retail Stores	204483	179750
5541	Service Stations ( with or without ancillary services)	130722	189541
5411	Grocery Stores, Supermarkets	152744	189982
5814	Fast Food Restaurants	236911	300474

feb <- plot_month("02","Feb")
feb$plt

feb$tbl

MCC	Description	2019	2020
4829	Money Orders – Wire Transfer	15253	44139
5542	Automated Fuel Dispensers	42562	49137
5499	Misc. Food Stores – Convenience Stores and Specialty Markets	41143	56096
6011	Financial Institutions – Manual Cash Disbursements	47793	85592
4121	Taxicabs and Limousines	84758	89658
5541	Service Stations ( with or without ancillary services)	125513	142621
5411	Grocery Stores, Supermarkets	151210	160088
5812	Eating places and Restaurants	144215	186259
5814	Fast Food Restaurants	236745	301869
5999	Miscellaneous and Specialty Retail Stores	203356	325414

mar <- plot_month("03","Mar")
mar$plt

mar$tbl

MCC	Description	2019	2020
5735	Record Shops	23904	46108
4829	Money Orders – Wire Transfer	18707	48890
5499	Misc. Food Stores – Convenience Stores and Specialty Markets	50274	59528
4121	Taxicabs and Limousines	100191	68208
6011	Financial Institutions – Manual Cash Disbursements	56766	79597
5541	Service Stations ( with or without ancillary services)	148208	140964
5812	Eating places and Restaurants	177563	148624
5411	Grocery Stores, Supermarkets	170894	180237
5814	Fast Food Restaurants	284305	261753
5999	Miscellaneous and Specialty Retail Stores	243923	310774

apr <- plot_month("04","Apr")
apr$plt

apr$tbl

MCC	Description	2019	2020
5942	Book Stores	26974	25455
5735	Record Shops	29313	28662
5499	Misc. Food Stores – Convenience Stores and Specialty Markets	50755	30979
4829	Money Orders – Wire Transfer	19355	37603
6011	Financial Institutions – Manual Cash Disbursements	56793	41980
5812	Eating places and Restaurants	166319	61977
5541	Service Stations ( with or without ancillary services)	145971	70446
5411	Grocery Stores, Supermarkets	162668	89860
5814	Fast Food Restaurants	282207	107498
5999	Miscellaneous and Specialty Retail Stores	258077	129933

Online vs. Instore Spending Trends Due to SIP Orders

# compare instore to online ratio and potential for the online shift before and after covid
#   transactions_ratio >> on a given day, ___ times more people shop instores rather than online (2 line graph showing the trend before and after covid and online vs instore trends)
# walmart_instore_sum <-
#   walmart_instore %>%
#   mutate(month = substr(date,1,7)) %>%
#   group_by(month) %>%
#   summarize(
#     mean=mean(as.numeric(total_spent)),
#     sum=sum(as.numeric(total_spent)),
#     avg_transactions=mean(as.numeric(transaction_counts)),
#     transactions=sum(as.numeric(transaction_counts)))
# 
# walmart_sum <-
#   walmart_online %>%
#   mutate(month = substr(date,1,7)) %>%
#   group_by(month) %>%
#   summarize(
#     mean=mean(as.numeric(total_spent)),
#     sum=sum(as.numeric(total_spent)),
#     avg_transactions=mean(as.numeric(transaction_counts)),
#     transactions=sum(as.numeric(transaction_counts))) %>%
#   left_join(walmart_instore_sum,by="month",suffix=c("_online","_instore"))
# 
# walmart_melt <-
#   walmart_sum %>%
#   tail(13) %>%
#   mutate(transactions_ratio_instore=(avg_transactions_instore)/(sum(walmart_sum[, 'avg_transactions_instore']))) %>%
#   mutate(transactions_ratio_online=(avg_transactions_online)/(sum(walmart_sum[, 'avg_transactions_online']))) %>%
#   dplyr::select(month,transactions_ratio_instore,transactions_ratio_online) %>%
#   melt(id=c("month"))
# 
# saveRDS(walmart_melt,"baymap/walmart_transactions.rds")

walmart_melt <- readRDS("baymap/walmart_transactions.rds")

wplt <- 
  ggplot(walmart_melt,aes(x=month,y=value,color=variable,group=variable)) +
  geom_line(size=1.5) +
  labs(y= "Transactions Ratio", x = "Date", color="Legend") +
  theme(axis.text.y =element_blank(),
        axis.ticks.y=element_blank())

wplt

# instore1920 <-
#   walmart_instore %>%
#   mutate(year = substr(date,1,4)) %>%
#   mutate(month = substr(date,6,7)) %>%
#   mutate(day = substr(date,9,10)) %>%
#   filter(year %in% c("2019","2020")) %>%
#   group_by(year,month) %>%
#   summarize(
#     avg_transactions=mean(as.numeric(transaction_counts))) %>% 
#   spread(year,avg_transactions) %>%
#   mutate(transactions_ratio=`2020`/`2019`) %>% 
#   gather("year",transactions_ratio,2:3)
# 
# instore_online_1920 <-
#   walmart_online %>%
#   mutate(year = substr(date,1,4)) %>%
#   mutate(day = substr(date,9,10)) %>%
#   mutate(month = substr(date,6,7)) %>%
#   filter(year %in% c("2019","2020")) %>%
#   group_by(year,month) %>%
#   summarize(
#     avg_transactions=mean(as.numeric(transaction_counts))) %>%
#   spread(year,avg_transactions) %>%
#   mutate(transactions_ratio=`2020`/`2019`) %>% 
#   gather("year",transactions_ratio,2:3) %>% 
#   left_join(instore1920,suffix=c("_online","_instore"),by=c("year","month")) %>%
#   unite(year_month,year,month,sep="-") %>%
#   dplyr::select(year_month,transactions_ratio_online,transactions_ratio_instore) %>%
#   melt(id=c("year_month")) %>% 
#   na.omit()
# 
# saveRDS(instore_online_1920,"baymap/instore_online_1920.rds")

instore_online_1920 <- readRDS("baymap/instore_online_1920.rds") 
  
ioplt <- 
  ggplot(instore_online_1920,aes(x=year_month,y=value,color=variable,group=1)) +
  geom_line(size=1) +
  labs(y= "Daily Avg Transactions", x = "Date", color="Legend")

ioplt %>% ggplotly()

# instore_ratio_1920 <-
#   walmart_instore %>%
#   mutate(year = substr(date,1,4)) %>%
#   mutate(month = substr(date,6,7)) %>%
#   mutate(day = substr(date,9,10)) %>%
#   filter(year %in% c("2019","2020")) %>%
#   group_by(year,month) %>%
#   summarize(
#     avg_transactions=mean(as.numeric(transaction_counts))) %>%
#   spread(year,avg_transactions) %>%
#   mutate(transactions_ratio=`2020`/`2019`)
# 
# inon_ratio_1920 <-
#   walmart_online %>%
#   mutate(year = substr(date,1,4)) %>%
#   mutate(day = substr(date,9,10)) %>%
#   mutate(month = substr(date,6,7)) %>%
#   filter(year %in% c("2019","2020")) %>%
#   group_by(year,month) %>%
#   summarize(
#     avg_transactions=mean(as.numeric(transaction_counts))) %>%
#   spread(year,avg_transactions) %>%
#   mutate(transactions_ratio=`2020`/`2019`) %>%
#   left_join(instore1920,suffix=c("_online","_instore"),by=c("month")) %>%
#   dplyr::select(month,transactions_ratio_online,transactions_ratio_instore) %>%
#   melt(id=c("month")) %>%
#   na.omit()
# 
# saveRDS(inon_ratio_1920,"baymap/inon_ratio_1920.rds")
# 
# inon_ratio_1920 <- readRDS("baymap/inon_ratio_1920.rds")
# 
# inonplt <- 
#   ggplot(instore_online_1920,aes(x="month",y=value,color=variable,group=1)) +
#   geom_line(size=1) +
#   labs(y= "Transactions Ratio", x = "Month", color="Legend")
# 
# inonplt %>% ggplotly()

Grocers Spending Trends Over the Years

# grocery spending impacts due to covid (line graphs by MCC) - show trends over the years

spending_grocers <-
  spending_MCC %>%
  filter(MCC=="5411") %>%
  saveRDS("baymap/spending_grocers.rds")
spending_grocers <- readRDS("baymap/spending_grocers.rds")

# spending_grocers_annual <-
#   spending_grocers %>%
#   filter(month(date)<=5) %>% 
#   group_by(year(date),month(date)) %>%
#   summarize(
#     mean=mean(as.numeric(total_spent))
#     ) %>%
#  arrange(`month(date)`)
# saveRDS(spending_grocers_annual,"baymap/spending_grocers_annual.rds")

spending_grocers_annual <- readRDS("baymap/spending_grocers_annual.rds")

grocer_annual <- 
  (ggplot(spending_grocers_annual,aes(x=as.character(`month(date)`),y=mean, color=as.character(`year(date)`), group=as.character(`year(date)`), text=paste0("$", round(mean,2)))) +
  geom_line(size=1.2) +
  geom_point(size=2) +
  scale_x_discrete(labels=c("1"="Jan","2" = "Feb", "3" = "Mar", "4" = "Apr", "5" = "May")) +
  labs(y= "Average Monthly Spendings on Groceries ($)", x = "Date", color="Legend") +
  theme_minimal() +
  theme(legend.position="top")) %>% 
  ggplotly(tooltip="text") %>% 
  config(displayModeBar = F) %>% 
  layout(legend = list(orientation="h",x = 0.4, y = -0.1))

grocer_annual

# spending_grocers_covid <-
#   spending_grocers %>%
#   filter(month(date)<=5) %>%
#   saveRDS("baymap/spending_grocers_covid.rds")
spending_grocers_covid <- readRDS("baymap/spending_grocers_covid.rds")

# spending_grocers_byweek <-
#   spending_grocers_covid %>%
#   group_by(week = week(date),year(date)) %>%
#   summarize(
#     mean=mean(as.numeric(total_spent))
#     ) %>%
#   saveRDS("baymap/spending_grocers_byweek.rds")

spending_grocers_byweek <- readRDS("baymap/spending_grocers_byweek.rds")

grocer_weekly <- 
  (ggplot(spending_grocers_byweek,aes(x=week,y=mean, color=as.character(`year(date)`),group=as.character(`year(date)`),text=paste0("Week ", week,": $", round(mean,2)))) +
  geom_point(size=2) +
  geom_line(size=1.2) +
  scale_x_continuous(breaks = seq(1, 22, by = 4)) +
  labs(y= "Average Weekly Spendings on Groceries ($)", x = "Week Number", color="Legend") +
  theme_minimal() +
  theme(legend.position="top")) %>% 
  ggplotly(tooltip="text") %>% 
  config(displayModeBar = F) %>% 
  layout(legend = list(orientation="h",x = 0.4, y = -0.1))

grocer_weekly

# spending_grocers_weekday <-
#   spending_grocers_covid %>%
#   group_by(wday(date),date,year(date)) %>%
#   summarize(
#     mean=mean(as.numeric(total_spent))
#     ) %>%
#   saveRDS("baymap/spending_grocers_weekday.rds")

spending_grocers_weekday <- readRDS("baymap/spending_grocers_weekday.rds")

grocer_weekday <- 
  (ggplot(spending_grocers_weekday, aes(x=as.character(`wday(date)`),y=mean, fill=as.character(`year(date)`),group=as.character(`year(date)`), text=paste0("$", round(mean,2)))) +
  geom_bar(stat="identity",position=position_dodge()) +
  scale_x_discrete(labels=c("1"="Sun","2" = "Mon", "3" = "Tues", "4" = "Wed", "5" = "Thurs", "6" = "Fri","7"="Sat")) +
  labs(y= "Average Daily Spendings on Groceries ($)", x = "Weekday", fill="Legend") +
  theme_minimal() +
  theme(legend.position="top")) %>% 
  ggplotly(tooltip="text") %>% 
  config(displayModeBar = F) %>% 
  layout(legend = list(orientation="h",x = 0.4, y = -0.1))

grocer_weekday

Walmart vs. SNAP Demographics

## most popular/accessible walmart among zipcodes (plot number of transactions on map)

bay_zipcodes <-
  read.csv("baymap/bayarea_zipcodes.csv") %>%
  dplyr::select(PO_NAME,ZIP)

bay_zipcodes$ZIP <- as.character(bay_zipcodes$ZIP)

# spending_brand_sum <-
#   bay_zipcodes %>%
#   left_join(spending_brand %>% filter(merchant=="WALMART"),by=c("ZIP"="zip")) %>% 
#   group_by(merchant,ZIP,PO_NAME) %>%
#   summarize(
#     transactions_avg=round(mean(as.numeric(transaction_counts)))) %>%
#   left_join(bay_zctas,by=c("ZIP"="ZCTA5CE10")) %>%
#   distinct(ZIP,.keep_all = T) %>%
#   st_as_sf(dim = "XY", sf_column_name = "geometry") %>%
#   st_transform(crs=4326) %>%
#   mutate(combined=paste0(ZIP,": ",round(transactions_avg)," Daily Avg Walmart Transactions")) %>% 
#   na.omit()
# 
# spending_brand_sum <- spending_brand_sum[order(spending_brand_sum$transactions_avg),]
# 
# saveRDS(spending_brand_sum,"baymap/spending_brand_sum.rds")
# 
# gcf["zip"] <- as.character(gcf$zip)
# 
# gcf_bay <-
#   gcf %>%
#   right_join(bay_zctas,by=c("zip"="ZCTA5CE10")) %>%
#   filter(zip %in% spending_brand_sum$ZIP) %>%
#   distinct(zip,.keep_all = T) %>%
#   st_as_sf(dim = "XY", sf_column_name = "geometry") %>%
#   st_transform(crs=4326) %>%
#   mutate(combined=paste0(zip,": ",total_individuals, " SNAP Residents")) %>% 
#   na.omit()
# 
# gcf_bay <- gcf_bay[order(gcf_bay$total_individuals),]
# 
# saveRDS(gcf_bay,"baymap/gcf_bay.rds")

spending_brand_sum <- readRDS("baymap/spending_brand_sum.rds")
spending_brand_sum_top10 <- tail(spending_brand_sum,10)
spending_brand_sum_top25 <- tail(spending_brand_sum,25)
spending_brand_sum_top50 <- tail(spending_brand_sum,50)

gcf_bay <- readRDS("baymap/gcf_bay.rds")
gcf_bay_top10 <- tail(gcf_bay,10)
gcf_bay_top25 <- tail(gcf_bay,25)
gcf_bay_top50 <- tail(gcf_bay,50)

col <- c("#068a9c","#d44a1e")

fp <- leaflet() %>%
    addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
    addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
    addPolygons(
      data = spending_brand_sum_top10,
      weight=2,
      color = "#5c2a9d",
      label = spending_brand_sum_top10$combined,
      group = "Walmart Top 10"
      ) %>%
    addPolygons(
      data = spending_brand_sum_top25,
      weight=2,
      color = "#5c2a9d",
      label = spending_brand_sum_top25$combined,
      group = "Walmart Top 25"
      ) %>%
    addPolygons(
      data = spending_brand_sum_top50,
      color = "#5c2a9d",
      weight=2,
      label =  spending_brand_sum_top50$combined,
      group = "Walmart Top 50"
      ) %>%
    addPolygons(
      data = gcf_bay_top10,
      weight=2,
      color = "#e2598b",
      label = gcf_bay_top10$combined,
      group = "SNAP Top 10"
      ) %>%
    addPolygons(
      data = gcf_bay_top25,
      weight=2,
      color = "#e2598b",
      label = gcf_bay_top25$combined,
      group = "SNAP Top 25"
      ) %>%
    addPolygons(
      data = gcf_bay_top50,
      color = "#e2598b",
      weight=2,
      label = gcf_bay_top50$combined,
      group = "SNAP Top 50"
      ) %>%
    addLayersControl(
      baseGroups = c("Default","Satellite"),
      overlayGroups = c("Walmart Top 10","Walmart Top 25","Walmart Top 50", 
                        "SNAP Top 10","SNAP Top 25", "SNAP Top 50")
    ) %>%
  hideGroup(c("Walmart Top 10","Walmart Top 50","SNAP Top 10","SNAP Top 50"))

fp

walsnap_tbl <-
  gcf_bay_top50 %>%
  dplyr::select(-geometry) %>%
  as.data.frame() %>%
  left_join(spending_brand_sum_top50 %>% dplyr::select(-geometry) %>% as.data.frame(), by=c("zip"="ZIP"),suffix=c("_SNAP","_walmart")) %>%
  na.omit() %>%
  dplyr::select(zip,total_individuals,transactions_avg) %>%
  left_join(bay_zipcodes, by=c("zip"="ZIP")) %>%
  dplyr::rename("Zip"="zip","CITY"="PO_NAME","SNAP Residents"="total_individuals","Daily Avg Walmart Transactions"="transactions_avg") %>% 
  formattable(align = c(rep("c"))) %>% 
  as.datatable()

walsnap_tbl

Shiny App Implementation